#lang scheme
;; SICP Chapter 2 exercises solution
;; Author: Zhu, Shenli (zhushenli AT gmail DOT com)
;; Ex.1.3 means exercise 1.3, every exercise solution have source code and some simple test cases (check-expect/check-within).
;; Environment: PLT-scheme(DrScheme)

(require test-engine/scheme-tests)
(require works/sicp-chap-1)
(provide
 for-each
 )
;;-------------------------------------------------------------------------
;; 2.1 Introduction to Data Abstraction
;;-------------------------------------------------------------------------
;; Ex.2.1
(define (add-rat x y)
  (make-signed-rat (+ (* (numer x) (denom y))
                      (* (numer y) (denom x)))
                   (* (denom x) (denom y))))

(define (sub-rat x y)
  (make-signed-rat (- (* (numer x) (denom y))
                      (* (numer y) (denom x)))
                   (* (denom x) (denom y))))

(define (mul-rat x y)
  (make-signed-rat (* (numer x) (numer y))
                   (* (denom x) (denom y))))

(define (div-rat x y)
  (make-signed-rat (* (numer x) (denom y))
                   (* (denom x) (numer y))))

(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

(define (numer x) (car x))

(define (denom x) (cdr x))

(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x)))

(define (make-rat n d sign)
  (let ((g (gcd n d)))
    (cons (sign (/ n g)) (/ d g))))

(define (make-signed-rat n d)
  (let ((abs_n (abs n))
        (abs_d (abs d)))
    (cond
      [(or (and (> n 0) (> d 0))
           (and (< n 0) (< d 0)))
       (make-rat abs_n abs_d +)]
      [else
       (make-rat abs_n abs_d -)])))

(define one-half (make-signed-rat 1 2))
(define n-one-half (make-signed-rat -1 2))
(define one-n-half (make-signed-rat 1 -2))
(define n-one-n-half (make-signed-rat -1 -2))

(define one-third (make-signed-rat 1 3))
(define n-one-third (make-signed-rat -1 3))

;(print-rat (add-rat one-half one-third))
;(print-rat n-one-half)
;(print-rat one-n-half)
;(print-rat n-one-n-half)
;(print-rat (add-rat n-one-half one-third)) ;-1/6
;(print-rat (add-rat one-half n-one-third)) ;1/6
;(print-rat (add-rat n-one-half n-one-third)) ; -5/6

;; Ex.2.2
(define (make-segment start end)
  (cons start end))

(define (start-segment line)
  (car line))

(define (end-segment line)
  (cdr line))

(define (make-point x y)
  (cons x y))

(define (x-point point)
  (car point))

(define (y-point point)
  (cdr point))

(define (midpoint-segment line)
  (let ((start-point (start-segment line))
        (end-point (end-segment line)))
    (make-point (/ (+ (x-point start-point) (x-point end-point)) 2)
                (/ (+ (y-point start-point) (y-point end-point)) 2))))

(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")")
  (newline))

(define (print-line l)
  (newline)
  (display "start:")
  (print-point (start-segment l))
  (display "end:")
  (print-point (end-segment l)))

(define l (make-segment (make-point 1 2) (make-point 4 8)))
;(print-line l)
(check-expect (midpoint-segment l) (cons 5/2 5))

;; Ex.2.3
(define (make-rect right-up-p left-bottom-p)
  (make-segment right-up-p left-bottom-p))

(define (rect-area r)
  (let ((left-bottom-p (start-segment r))
        (right-up-p (end-segment r)))
    (* (- (x-point right-up-p) (x-point left-bottom-p))
       (- (y-point right-up-p) (y-point left-bottom-p)))))

(define r (make-segment (make-point 4 8) (make-point 1 2)))
(check-expect (rect-area r) 18)

;; 2.1.3 (message passing style)
(define (cons-2 x y)
  (define (dispatch m)
    (cond ((= m 0) x)
          ((= m 1) y)
          (else (error "Argument not 0 or 1 -- CONS" m))))
  dispatch)

(define (car-2 z) (z 0))

(define (cdr-2 z) (z 1))

(define zz (cons-2 3 4))
(check-expect (car-2 zz) 3)
(check-expect (cdr-2 zz) 4)

;; Ex.2.4
(define (cons-3 x y)
  (lambda (m) (m x y)))

(define (car-3 z)
  (z (lambda (p q) p)))

(define (cdr-3 z)
  (z (lambda (p q) q)))

(define zz-2 (cons-3 3 4))
(check-expect (car-3 zz-2) 3)
(check-expect (cdr-3 zz-2) 4)

;; Ex.2.5
(define (cons-4 a b)
  (* (expt 2 a) (expt 3 b)))

(define (car-4 z)
  (if (not (= (remainder z 2) 0))
      0
      (+ 1 (car-4 (/ z 2)))))

(define (cdr-4 z)
  (if (not (= (remainder z 3) 0))
      0
      (+ 1 (cdr-4 (/ z 3)))))

(define zz-3 (cons-4 3 4))
(check-expect (car-4 zz-3) 3)
(check-expect (cdr-4 zz-3) 4)

;; Ex.2.6 "Church numerals" (not very hard, but how to verify it)
(define zero
  (lambda (f) (lambda (x) x)))

(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

;; using substitute in (add-1 zero) and we find ((n f) x)=>x
(define one
  (lambda (f) (lambda (x) (f x))))
;; (add-1 one)
(define two
  (lambda (f) (lambda (x) (f (f x)))))
(define three
  (lambda (f) (lambda (x) (f (f (f x))))))

(define (church-add m n)
  (lambda (f) (lambda (x) ((m f) ((n f) x)))))

;; use f=inc to verify the problem, not rigorous, but helpful for debugging
(check-expect ((zero inc) 0)  0)
(check-expect ((one inc) 0)   1)
(check-expect ((two inc) 0)   2)
(check-expect ((three inc) 0) 3)

(check-expect (((church-add one two) inc) 0) ((three inc) 0))

; Interval Arithmetic
(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

;; Ex.2.7
(define (make-interval lb ub) (cons lb ub))
(define (lower-bound interval) (car interval))
(define (upper-bound interval) (cdr interval))

;; Ex.2.8
(define (sub-interval x y)
  (make-interval (- (upper-bound x) (lower-bound y))
                 (- (lower-bound x) (upper-bound y))))

;; Ex.2.9
(define (width x)
  (/ (- (upper-bound x) (lower-bound x)) 2))

;; (width (add-interval x y)) = (+ (width x) (width y))
;; (width (sub-interval x y)) = (+ (width x) (width y))
;; because min and max in mul and div are not linear, so cannot get the result

;; Ex.2.10
(define (div-interval x y)
  (if (or (zero? (upper-bound y)) (zero? (lower-bound y)))
      (error "div zero in y")
      (mul-interval x
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

;; Ex.2.11
;; three case: both > 0, both < 0, span 0, I dont' want to write the test cases, it's time-consuming and boring, so the program below may have bug
(define (mul-interval-fast x y)
  (let ((ux (upper-bound x))
        (lx (lower-bound x))
        (uy (upper-bound y))
        (ly (lower-bound y)))
    (cond
      [(>= lx 0)
       (cond
         [(>= ly 0) (make-interval (* lx ly)(* ux uy))]
         [(and (< ly 0) (> uy 0)) (make-interval (* ux ly)(* ux uy))]
         [(<= uy 0) (make-interval (* ux ly)(* lx uy))])]
      [(and (> ux 0) (< lx 0))
       (cond
         [(>= ly 0) (make-interval (* lx uy)(* ux uy))]
         [(and (< ly 0)(> uy 0))
          (make-interval (min (* lx uy) (* ux ly)) (max (* lx ly) (* ux uy)))] ; only branch have four mul
         [(<= uy 0) (make-interval (* ux ly)(* lx ly))])]
      [(<= ux 0)
       (cond
         [(>= ly 0) (make-interval (* lx uy)(* ux ly))]
         [(and (< ly 0)(> uy 0)) (make-interval (* lx uy)(* lx ly))]
         [(<= uy 0) (* ux uy)(* lx ly)])])))

;; Ex.2.12
(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))

(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

(define (make-center-percent c pt)
  (make-interval (* c (- 1 pt)) (* c (+ 1 pt))))

(define (percent i)
  ((width i) / (center i)))

;; Ex.2.13
;; (easy) assuming tolerance of x is a, y is b, z is c, so, x*y's tolerance is (a+b) / (1+a*b),

;;* Tolerance table in 2.1.4, the idea from Ex.2.13, but I don't have time to check whether they are right, I will do it when I am forced to designed it in my future job work :)
;;| Expression      | Center | Tolerance                | Notes   |
;;|-----------------+--------+--------------------------+---------|
;;| x               | X      | a                        |         |
;;| y               | Y      | b                        |         |
;;| z               | Z      | c                        |         |
;;| x+y             |        | (aX+bY)/(X+Y)            |         |
;;| x*y             |        | (a+b)/(1+ab)             | Ex.2.13 |
;;| x*y*z           |        | (a+b+c+abc)/(1+ab+bc+ac) |         |
;;| x*(1/x)*y       |        | (2a+b+a^2*b)/(2ab+a^2+1) | Ex.2.16 |
;;| (1/x)           |        | a                        |         |
;;| xy/(x+y)        |        | Don't equal to below     | Ex.2.13 |
;;| 1/((1/x)+(1/y)) |        | (X+Y)/(aX+bY)            | Ex.2.13 |

;; Ex.2.14
;; Is the + and - reversable, same to * and /, we must try all the formular like combination and switch in basic linear algebra to testify the system. I guess the Interval and tolerance Arithmetic may be hard or even impossible to implement. So, skip 2.14 to 2.15 for time-saving.

;; Ex.2.15
;; Each mul with two variable will enlarge the tolerance, for example t(x*(1/x)*y) > t(y). There are 3 mul in xy/(x+y), but 0 mul in 1/((1/x)+(1/y)) (note: 1/x is not a mul), so later one have small tolerance. Or if in several same expression, the one have the smallest tolerance is the right one? I am not sure. The question is left for further exploration.

;; Ex.2.16
;; Maybe impossible, because I have never seen such a package :), other idea like fuzzy logic are feasible in real project.

;;-------------------------------------------------------------------------
;; 2.2 Hierarchical Data and the Closure Property
;;-------------------------------------------------------------------------
;; Ex.2.17
(define (last-pair lat)
  (if (null? (cdr lat))
      lat
      (last-pair (cdr lat))))

(check-expect (last-pair (list 23 72 149 34)) '(34))

;; Ex.2.18
(define (reverse lat)
  (if (null? (cdr lat))
      (list (car lat))
      (append (reverse (cdr lat)) (list (car lat)))))

(check-expect (reverse (list 1 4 9 16 25)) '(25 16 9 4 1))

;; Ex.2.19
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

(define no-more? null?)
(define first-denomination car)
(define except-first-denomination cdr)

(check-expect (cc 100 us-coins) 292)
(check-expect (cc 100 (reverse us-coins)) 292)
;; order don't affact the result, but how to prove it? Delay this.

;; Ex.2.20
(define (same-parity . lat)
  (if (odd? (car lat))
      (filter odd? lat)
      (filter even? lat)))

(check-expect (same-parity 1 2 3 4 5 6 7) '(1 3 5 7))
(check-expect (same-parity 2 3 4 5 6 7) '(2 4 6))

;; Ex.2.21
(define (square-list-1 items)
  (if (null? items)
      '()
      (cons (square (car items)) (square-list-1 (cdr items)) )))
(check-expect (square-list-1 (list 1 2 3 4)) '(1 4 9 16))

(define (square-list-2 items)
  (map square items))
(check-expect (square-list-2 (list 1 2 3 4)) '(1 4 9 16))

;; Ex.2.22 (correct, use append)
(define (square-list-3 items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things)
              (append answer
                    (list (square (car things)))))))
  (iter items '()))

(check-expect (square-list-3 (list 1 2 3 4)) '(1 4 9 16))

;; Ex.2.23 (I don't know how to solve the bug yet, delay)
;; section 2.2.4 use this proc, so return to it.
;; copy from http://community.schemewiki.org/?sicp-ex-2.23
;; it says cond is better for multi-line branches,
;; I see, if means you must choose one branch from two choices, while cond means you can do either 0, 1, ...n choices.
;; So, cond is better :)
(define (for-each proc items)
  (cond [(not (null? items))
         (proc (car items))
         (for-each proc (cdr items))]))

(for-each (lambda (x) (newline) (display x))
          (list 'Ex.2.23.for-each 1 2 3))

;; Ex.2.24, simple
(check-expect (list 1 (list 2 (list 3 4))) '(1 (2 (3 4))))
(newline)

;; Ex.2.25
(check-expect (car (cdaddr '(1 3 (5 7) 9))) 7)
(check-expect (caar '((7))) 7)
(check-expect (cadadr (cadadr (cadadr '(1 (2 (3 (4 (5 (6 7))))))))) 7)

;; Ex.2.26
(define x (list 1 2 3))
(define y (list 4 5 6))

(check-expect (append x y) '(1 2 3 4 5 6))
(check-expect (cons x y) '((1 2 3) 4 5 6))
(check-expect (list x y) '((1 2 3)(4 5 6)))

;; Ex.2.27
(define x2 (list (list 1 2) (list 3 4)))

(define (deep-reverse l)
  (cond
    [(null? l) '()]
    [(not (pair? l)) l] ;;atom
    [else
      (append (deep-reverse (cdr l)) (list (deep-reverse (car l))))]))

(check-expect (deep-reverse x2) '((4 3) (2 1)))

;; Ex.2.28
(define (fringe l)
  (cond
    [(null? l) '()]
    [(not (pair? l)) (list l)] ;;atom
    [else
      (append (fringe (car l)) (fringe (cdr l)))]))

(check-expect (fringe x2) '(1 2 3 4))
(check-expect (fringe (list x2 x2)) '(1 2 3 4 1 2 3 4))

;; Ex.2.29 (I haven't write test case for this exercise)
(define (make-mobile left right)
  (list left right))

;; `structure' may be either a number (representing a simple weight) or another mobile
(define (make-branch length structure)
  (list length structure))

;; a
(define left-branch-i car)
(define right-branch-i cadr)

(define branch-length car)
(define branch-structure cadr)

;; b
(define (atom? x) ;; useful function from TLS
  (not (or (null? x) (pair? x))))

(define (total-weight m)
  (cond
    [(atom? m) m]
    [else
     (+ (total-weight (branch-structure (left-branch-i m))) (total-weight (branch-structure (right-branch-i m))))]))

;; c (don't understand the problem very well)
;; there are two possible interpretion of the problem
;; simple one: only test the weight*length for every two branch
;; hard one: weight * (recursive added length), this one is true in real world.
;; so skip it

;; d, skip it

;; Ex.2.30
;; no higher-order function
(define (square-tree t)
  (cond
    [(null? t) '()]
    [(not (pair? t)) (square t)]
    [else
      (cons (square-tree (car t)) (square-tree (cdr t)))]))

(check-expect (square-tree
               (list 1
                     (list 2 (list 3 4) 5)
                     (list 6 7))) '(1 (4 (9 16) 25) (36 49)))

;; higher-order function (a bit difficult to understand)
(define (square-tree-map t)
  (map (lambda (sub-t)
         (if (pair? sub-t)
             (square-tree-map sub-t)
             (square sub-t)))
       t))

(check-expect (square-tree-map
               (list 1
                     (list 2 (list 3 4) 5)
                     (list 6 7))) '(1 (4 (9 16) 25) (36 49)))

;; Ex.2.31
(define (tree-map f t)
  (map (lambda (sub-t)
         (if (pair? sub-t)
             (tree-map f sub-t)
             (f sub-t)))
       t))

(define (square-tree-map-2 tree) (tree-map square tree))

(check-expect (square-tree-map-2
               (list 1
                     (list 2 (list 3 4) 5)
                     (list 6 7))) '(1 (4 (9 16) 25) (36 49)))

;; Ex.2.32 (a bit hard)
;; example
;;()
;;(3)
;;(2) (2 3)
;;(1) (1 3) (1 2) (1 2 3)

(define (subsets s)
  (if (null? s)
      '(())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (append (list (car s)) x)) rest)))))

(check-expect (subsets (list 1 2 3)) '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)))

;; 2.2.3
;; accumulate is reduce
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (cons low (enumerate-interval (+ low 1) high))))
(check-expect (enumerate-interval 2 7) '(2 3 4 5 6 7))

(define enumerate-tree fringe)
(check-expect (enumerate-tree (list 1 (list 2 (list 3 4)) 5)) '(1 2 3 4 5))

;; Ex.2.33
(define (map-2 p sequence)
  (accumulate (lambda (x y) (cons (p (car sequence)) (map-2 p (cdr sequence)))) '() sequence))
(check-expect (map-2 square '(1 2 3)) (map square '(1 2 3)))

(define (append-2 seq1 seq2)
  (accumulate cons seq2 seq1))
(check-expect (append-2 '(1 2) '(3 4)) (append '(1 2) '(3 4)))

(define (length-2 sequence)
  (accumulate (lambda (x y) (inc y)) 0 sequence))
(check-expect (length-2 '(3 4 5)) (length '(3 4 5)))

;; Ex.2.34 (a bit hard)
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* higher-terms x)))
              0
              coefficient-sequence))

;; 1 + 3x + 5x^3 + x^5, x=2
(check-expect (horner-eval 2 (list 1 3 0 5 0 1)) 79)

;; Ex.2.35
(define (count-leaves t)
  (accumulate + 0 (map (lambda (x) 1) (enumerate-tree t))))
(check-expect (count-leaves x2) 4)
(check-expect (count-leaves (list x2 x2)) 8)

;; Ex.2.36 (a bit hard)
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      '()
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

(check-expect (accumulate-n + 0 '((1 2 3) (4 5 6) (7 8 9) (10 11 12))) '(22 26 30))

;; Ex.2.37
(define v '(1 2 3 4))
(define w '(1 3 5 7))
(define m '((1 2 3 4) (4 5 6 6) (6 7 8 9)))
(define n '((1 2) (1 2) (1 2) (1 2)))

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(check-expect (dot-product v w) 50)

(define (matrix-*-vector m v)
  (map (lambda (w) (dot-product w v)) m))

(check-expect (matrix-*-vector m v) '(30 56 80))

(define (transpose mat)
  (accumulate-n cons '() mat))

(check-expect (transpose m) '((1 4 6) (2 5 7) (3 6 8) (4 6 9)))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (v) (matrix-*-vector cols v)) m)))

(check-expect (matrix-*-matrix m n) '((10 20) (21 42) (30 60)))

;; Ex.2.38
(define fold-right accumulate)

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

(check-expect (fold-right / 1 (list 1 2 3)) 3/2)
(check-expect (fold-left / 1 (list 1 2 3)) 1/6)
(check-expect (fold-right list '() (list 1 2 3)) '(1 (2 (3 ()))))
(check-expect (fold-left list '() (list 1 2 3)) '(((() 1) 2) 3))

;; property 1: (op a (op b c)) == (op b (op a c))
;; property 2: (op a b) == (op b a)
;; Prove: (op a (op b c)) == (op c (op b a)) == (op (op b a) c) == (op (op a b) c)

;; Ex.2.39
(define (reverse-fr sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))

(check-expect (reverse-fr (list 1 4 9 16 25)) '(25 16 9 4 1))

(define (reverse-fl sequence)
  (fold-left (lambda (x y) (append (list y) x)) '() sequence))

(check-expect (reverse-fl (list 1 4 9 16 25)) '(25 16 9 4 1))

;; Nested Mapping(tricky)
(check-expect (accumulate append
                 '()
                 (map (lambda (i)
                        (map (lambda (j) (list i j))
                             (enumerate-interval 1 (- i 1))))
                      (enumerate-interval 1 4)))
              '((2 1) (3 1) (3 2) (4 1) (4 2) (4 3)))

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)))))

(check-expect (prime-sum-pairs 6) '((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11)))

(define (permutations s)
  (if (null? s)                    ; empty set?
      (list '())                   ; sequence containing empty set
      (flatmap (lambda (x)
                 (map (lambda (p) (cons x p))
                      (permutations (remove x s))))
               s)))

(check-expect (permutations '(1 2 3)) '((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)))

;; Ex.2.40
(define (unique-pairs n)
  (flatmap
   (lambda (i)
     (map (lambda (j) (list i j))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

(check-expect (unique-pairs 4) '((2 1) (3 1) (3 2) (4 1) (4 2) (4 3)))

(define (prime-sum-pairs-2 n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))

(check-expect (prime-sum-pairs-2 6) '((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11)))

;; Ex.2.41
(define (unique-triples n)
  (flatmap (lambda (i)
     (flatmap (lambda (j)
        (map (lambda (k) (list i j k))
             (enumerate-interval 1 (- j 1))))
          (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

(check-expect (unique-triples 5) '((3 2 1) (4 2 1) (4 3 1) (4 3 2) (5 2 1) (5 3 1) (5 3 2) (5 4 1) (5 4 2) (5 4 3)))

(define (make-triple-sum triple)
  (let ([i (car triple)]
        [j (cadr triple)]
        [k (caddr triple)])
    (list i j k (+ i j k))))

(define (sum-triples-eq-s n s)
  (filter
   (lambda (t) (= (cadddr t) s))
   (map make-triple-sum (unique-triples n))))

(check-expect (sum-triples-eq-s 5 10) '((5 3 2 10) (5 4 1 10)))

;; Ex.2.42
;; the actual positions in program should be reversed to make most recent element access fast.
;; like c_n->c_n-1->...->c_1, c_n is column number
(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

;; refer to http://en.wikipedia.org/wiki/Eight_queens_puzzle
(check-expect (queens 4) '((3 1 4 2) (2 4 1 3)))
(check-expect (length (queens 4)) 2)
(check-expect (length (queens 5)) 10)
(check-expect (length (queens 6)) 4)
(check-expect (length (queens 7)) 40)
(check-expect (length (queens 8)) 92)
;(check-expect (length (queens 9)) 352)
;(check-expect (length (queens 10)) 724)

(define empty-board '())

(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

;; we need not to check column
(define (safe? k positions)
  (let ([cur-pos (car positions)]
        [prev-pos (cdr positions)])
    (not (or (check-row cur-pos prev-pos)
             (check-diagonal cur-pos prev-pos 1)))))

(check-expect (safe? 4 '(1 1 4 2)) #f)
(check-expect (safe? 4 '(2 1 4 2)) #f)
(check-expect (safe? 4 '(3 1 4 2)) #t)
(check-expect (safe? 4 '(4 1 4 2)) #f)

(define (check-row cur-pos prev-pos)
  (cond
    [(null? prev-pos) #f]
    [else
     (or (= cur-pos (car prev-pos))
         (check-row cur-pos (cdr prev-pos)))]))

(check-expect (check-row 1 '(1 4 2)) #t)
(check-expect (check-row 2 '(1 4 2)) #t)
(check-expect (check-row 3 '(1 4 2)) #f)
(check-expect (check-row 4 '(1 4 2)) #t)

(define (check-diagonal cur-pos prev-pos d-col)
  (cond
    [(null? prev-pos) #f]
    [else
     (or (= (abs (- cur-pos (car prev-pos))) d-col)
         (check-diagonal cur-pos (cdr prev-pos) (+ d-col 1)))]))

(check-expect (check-diagonal 1 '(2 4 1) 1) #t)
(check-expect (check-diagonal 2 '(2 4 1) 1) #t)
(check-expect (check-diagonal 3 '(2 4 1) 1) #t)
(check-expect (check-diagonal 4 '(2 4 1) 1) #t)

(check-expect (check-diagonal 1 '(1 4 2) 1) #f)
(check-expect (check-diagonal 2 '(1 4 2) 1) #t)
(check-expect (check-diagonal 3 '(1 4 2) 1) #f)
(check-expect (check-diagonal 4 '(1 4 2) 1) #f)

;; Ex.2.43
(define (queens-slow board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (new-row)
            (map (lambda (rest-of-queens)
                   (adjoin-position new-row k rest-of-queens))
                 (queen-cols (- k 1))))
          (enumerate-interval 1 board-size)))))
  (queen-cols board-size))

;(time (length (queens-slow 7))) ;; 5281
;(time (length (queens 7))) ;;16
;(time (length (queens-slow 8))) ;; 117422
;(time (length (queens 8))) ;;47

;; I guess the (queen-cols (- k 1)) will have to be re-calculated each time we call map.
;; assume (time (queens 7)) = T_7, so queens-slow takes Ts_8 = 8 * Ts_7 to give out all the (queens 8) candidates.
;; real time ratio Ts_8/T_8 = 2500, Ts_8/Ts_7 = 21, why?

;; A Picture Language (When I finish 2.5.2, I decided go back to this, i think it may relax my mind. Before I work on it, I guess it is another image process program, but I am wrong, it is harder than it. The topic is always recursion).
;; In order to verify my code, I have to find the way in printing draw. But before that, I should figure out how this language works.
;; Ex.2.44 ~ Ex.2.52, see sicp-chap-2.2.4.ss

;;-------------------------------------------------------------------------
;; 2.3 Symbolic Data
;;-------------------------------------------------------------------------
;; Ex.2.53
(check-expect (list 'a 'b 'c) '(a b c))
(check-expect (list (list 'george)) '((george)))
(check-expect (cdr '((x1 x2) (y1 y2))) '((y1 y2)))
(check-expect (cadr '((x1 x2) (y1 y2))) '(y1 y2))
(check-expect (pair? (car '(a short list))) #f)
(check-expect (memq 'red '((red shoes) (blue socks))) #f)
(check-expect (memq 'red '(red shoes blue socks)) '(red shoes blue socks))

;; Ex.2.54
(define (equal-2? l1 l2)
  (cond
    [(and (null? l1) (null? l2)) #t ]
    [(and (atom? l1) (atom? l2) (eq? l1 l2)) #t]
    [(and (pair? l1) (pair? l2))
      (and (equal-2? (car l1) (car l2)) (equal-2? (cdr l1) (cdr l2)))]
    [else #f]))
(check-expect (equal-2? '(this is a list) '(this is a list)) #t)
(check-expect (equal-2? '(this is a list) '(this (is a) list)) #f)

;; Ex.2.55
;; ''a is equal to '(quote a)
(check-expect (equal? ''a '(quote a)) #t)

;; Symbolic Differentiation
(define (deriv exp var)
  (cond
    ((compound? exp) ;; add compound to check standard algebraic notation
     (deriv (make-compound exp) var))
    ((number? exp) 0)
    ((variable? exp)
     (if (same-variable? exp var) 1 0))
    ((sum? exp)
     (make-sum (deriv (addend exp) var)
               (deriv (augend exp) var)))
    ((product? exp)
     (make-sum
      (make-product (multiplier exp)
                    (deriv (multiplicand exp) var))
      (make-product (deriv (multiplier exp) var)
                    (multiplicand exp))))
    ((exponentiation? exp)
     (make-product
      (make-product (exponent exp)
                    (make-exponentiation (base exp) (make-sum (exponent exp) -1)))
      (deriv (base exp) var)))
    (else
     (error "unknown expression type -- DERIV" exp))))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else
          (if (eq? deriv-mode 'prefix)
              (list '+ a1 a2)
              (list a1 '+ a2)))))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else
          (if (eq? deriv-mode 'prefix)
              (list '* m1 m2)
              (list m1 '* m2)))))

(define (make-exponentiation b e)
  (cond
    ((=number? e 0) 1)
    ((=number? e 1) b)
    (else
      (if (eq? deriv-mode 'prefix)
          (list '** b e)
          (list b '** e)))))

(define (sum? x)
  (if (eq? deriv-mode 'prefix)
    (and (pair? x) (eq? (car x) '+))
    (and (pair? x) (eq? (cadr x) '+))))

(define (addend s)
  (if (eq? deriv-mode 'prefix)
    (cadr s)
    (car s)))

(define (augend s)
  (if (eq? deriv-mode 'prefix)
      (if (null? (cdddr s))
          (caddr s)
          (cons '+ (cddr s)))
      (caddr s)))

(define (product? x)
  (if (eq? deriv-mode 'prefix)
    (and (pair? x) (eq? (car x) '*))
    (and (pair? x) (eq? (cadr x) '*))))

(define (multiplier p)
  (if (eq? deriv-mode 'prefix)
    (cadr p)
    (car p)))

(define (multiplicand p)
  (if (eq? deriv-mode 'prefix)
      (if (null? (cdddr p))
          (caddr p)
          (cons '* (cddr p)))
      (caddr p)))

(define (exponentiation? x)
  (if (eq? deriv-mode 'prefix)
    (and (pair? x) (eq? (car x) '**))
    (and (pair? x) (eq? (cadr x) '**))))

(define (base e)
  (if (eq? deriv-mode 'prefix)
    (cadr e)
    (car e)))

(define (exponent e) (caddr e))

;; Ex.2.56, see above (there is a bug in test-engine/scheme-tests, define and set!), uncomment the test case of prefix if you want to test it.
(define deriv-mode 'prefix)
;(check-expect (deriv '(** x 1) 'x) 1)
;(check-expect (deriv '(** x 2) 'x) '(* 2 x))
;(check-expect (deriv '(** x 3) 'x) '(* 3 (** x 2)))
;(check-expect (deriv '(** (+ x 2) 3) 'x) '(* 3 (** (+ x 2) 2)))

;; Ex.2.57
;(check-expect (deriv '(+ (** x 2) (* x 5) (* x y)) 'x) '(+ (* 2 x) (+ 5 y)))
;(check-expect (deriv '(* x y (+ x 3)) 'x) '(+ (* x y) (* y (+ x 3))))

;; Ex.2.58, infix (a+b) style, change in above code
;; Part a
(set! deriv-mode 'infix)
(check-expect (deriv '(x + (3 * (x + (y + 2)))) 'x) 4)
(check-expect (deriv '((x + 2) ** 3) 'x) '(3 * ((x + 2) ** 2)))

;; Part b, all expression can be written as (a op b op c op d ...), so we can add parentheses by op's priority, and reuse the original deriv
;; priority list
(define op-priority '(+ * **))

(define (compound? x)
  (if (eq? deriv-mode 'infix)
    (and (pair? x) (> (length x) 3))
    #f))

(define (make-compound c)
  (op-spliter-by-op-priority c op-priority))

;; find the first operator and split the list on it,
;; e.g.1 operator is '+, (list A * B + C), result is ((A * B) + C)
;; e.g.1 operator is '+, (list A * B * C), result is #f
(define (op-spliter expr op)
  (define (op-spliter-iter op-left op-next op-right)
    (if (eq? op op-next)
        (list op-left op-next (if (= (length op-right) 1) (car op-right) op-right))
        (if (null? (cdr op-right))
            #f
            (op-spliter-iter
              (append (if (pair? op-left) op-left (list op-left)) (list op-next))
              (car op-right)
              (cdr op-right)))))
  (op-spliter-iter (car expr) (cadr expr) (cddr expr)))

(check-expect (op-spliter '(a + b * c) '+) '(a + (b * c)))
(check-expect (op-spliter '(a * b + c) '+) '((a * b) + c))
(check-expect (op-spliter '(a * b + c + d) '+) '((a * b) + (c + d)))
(check-expect (op-spliter '(a * b + c * d) '+) '((a * b) + (c * d)))
(check-expect (op-spliter '(a + b * c + d) '+) '(a + (b * c + d)))
(check-expect (op-spliter '(a * b * c * d) '+) #f)
(check-expect (op-spliter '(a * b * c + d) '+) '((a * b * c) + d))

(define (op-spliter-by-op-priority expr op-priority)
  (if (not (eq? (op-spliter expr (car op-priority)) #f))
      (op-spliter expr (car op-priority))
      (if (null? (cdr op-priority))
          #f
          (op-spliter-by-op-priority expr (cdr op-priority)))))

(check-expect (op-spliter-by-op-priority '(a + b * c) op-priority) '(a + (b * c)))
(check-expect (op-spliter-by-op-priority '(a * b + c) op-priority) '((a * b) + c))
(check-expect (op-spliter-by-op-priority '(a ** b + c) op-priority) '((a ** b) + c))
(check-expect (op-spliter-by-op-priority '(a + b ** c) op-priority) '(a + (b ** c)))
(check-expect (op-spliter-by-op-priority '(a * b ** c) op-priority) '(a * (b ** c)))
(check-expect (op-spliter-by-op-priority '(a ** b * c) op-priority) '((a ** b) * c))
(check-expect (op-spliter-by-op-priority '(a + b + c + d) op-priority) '(a + (b + c + d)))
(check-expect (op-spliter-by-op-priority '(a ** b * c + d) op-priority) '((a ** b * c) + d))
(check-expect (op-spliter-by-op-priority '(a * b + c ** d) op-priority) '((a * b) + (c ** d)))
(check-expect (op-spliter-by-op-priority '(a ** b * c ** d) op-priority) '((a ** b) * (c ** d)))
(check-expect (op-spliter-by-op-priority '(a ** b ** c * d) op-priority) '((a ** b ** c) * d))
(check-expect (op-spliter-by-op-priority '(a ** b ** c ** d) op-priority) '(a ** (b ** c ** d)))
(check-expect (op-spliter-by-op-priority '(a / b / c / d) op-priority) #f)

(check-expect (deriv '(x + 3 * (x + y + 2)) 'x) 4)
(check-expect (deriv '(x + x ** 2 + 3 * (x + y + 2)) 'x) '(1 + ((2 * x) + 3)))
(check-expect (deriv '(x + ((x ** 2) + (3 * (x + (y + 2))))) 'x) '(1 + ((2 * x) + 3)))

;; the harder problem will be how to expand the result '(1 + ((2 * x) + 3)) to '(2 * x + 4), but stop it here now, or I will work on it for at least a year :)

;; Representing Sets: unordered list
(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))

(check-expect (element-of-set? 'b '(a b c)) #t)
(check-expect (element-of-set? 'd '(a b c)) #f)

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))

(check-expect (adjoin-set 'b '(a b c)) '(a b c))
(check-expect (adjoin-set 'd '(a b c)) '(d a b c))

(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) '())
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

(check-expect (intersection-set '(a b c) '(b c d)) '(b c))
(check-expect (intersection-set '(b c d) '(a b c)) '(b c))
(check-expect (intersection-set '(d e f) '(a b c)) '())

;; Ex.2.59
(define (union-set set1 set2)
  (cond
    [(null? set1) set2]
    [(not (element-of-set? (car set1) set2))
     (cons (car set1)
           (union-set (cdr set1) set2))]
    [else (union-set (cdr set1) set2)]))

(check-expect (union-set '(a b c) '(b c d)) '(a b c d))
(check-expect (union-set '(b c d) '(a b c)) '(d a b c))
(check-expect (union-set '(d e f) '(a b c)) '(d e f a b c))

;; Ex.2.60 (set: list with duplicates)
;; not large set, because union will append all the data without remove the redundent records
(define element-of-set-d? element-of-set?) ;; same to previous
(check-expect (element-of-set? 'b '(a b a c)) #t)
(check-expect (element-of-set? 'd '(a b a c)) #f)

(define adjoin-set-d cons) ;; just connect and do not need check, simpler
(check-expect (adjoin-set-d 'b '(a b a c)) '(b a b a c))
(check-expect (adjoin-set-d 'd '(a b a c)) '(d a b a c))

(define intersection-set-d intersection-set) ;; same to previous
(check-expect (intersection-set-d '(a b a c b) '(b c d b)) '(b c b))

(define union-set-d append) ;; just connect and do not need check, simpler
(check-expect (union-set-d '(a b a c) '(b c b d)) '(a b a c b c b d))

;; set: ordered list
(define (element-of-set-o? x set)
  (cond ((null? set) false)
        ((= x (car set)) #t)
        ((< x (car set)) #f)
        (else (element-of-set? x (cdr set)))))

(check-expect (element-of-set-o? 5 '(3 4 7)) #f)
(check-expect (element-of-set-o? 5 '(3 5 7)) #t)
(check-expect (element-of-set-o? 5 '(3 6 7)) #f)

(define (intersection-set-o set1 set2)
  (if (or (null? set1) (null? set2))
      '()
      (let ((x1 (car set1)) (x2 (car set2)))
        (cond ((= x1 x2)
               (cons x1
                     (intersection-set (cdr set1)
                                       (cdr set2))))
              ((< x1 x2)
               (intersection-set (cdr set1) set2))
              ((< x2 x1)
               (intersection-set set1 (cdr set2)))))))

(check-expect (intersection-set-o '(2 3 5 7 9) '(3 4 7)) '(3 7))

;; Ex.2.61
(define (adjoin-set-o x set)
  (if (null? set) (list x)
    (let ([s (car set)])
      (cond
        [(= x s) set]
        [(> x s) (cons s (adjoin-set-o x (cdr set)))]
        [(< x s) (cons x set)]))))

(check-expect (adjoin-set-o 1 '(2 3 5 7 9)) '(1 2 3 5 7 9))
(check-expect (adjoin-set-o 2 '(2 3 5 7 9)) '(2 3 5 7 9))
(check-expect (adjoin-set-o 3 '(2 3 5 7 9)) '(2 3 5 7 9))
(check-expect (adjoin-set-o 4 '(2 3 5 7 9)) '(2 3 4 5 7 9))
(check-expect (adjoin-set-o 9 '(2 3 5 7 9)) '(2 3 5 7 9))
(check-expect (adjoin-set-o 10 '(2 3 5 7 9)) '(2 3 5 7 9 10))

;; Ex.2.62
(define (union-set-o set1 set2)
  (cond
    [(null? set1) set2]
    [(null? set2) set1]
    [else
     (let ((x1 (car set1)) (x2 (car set2)))
       (cond ((= x1 x2)
              (cons x1
                    (union-set-o (cdr set1)
                                      (cdr set2))))
             ((< x1 x2)
              (cons x1 (union-set-o (cdr set1) set2)))
             ((< x2 x1)
              (cons x2 (union-set-o set1 (cdr set2))))))]))

(check-expect (union-set-o '(2 3 5 7 9) '(3 4 7)) '(2 3 4 5 7 9))

;; set: binary tree
(define (entry-b tree) (car tree))

(define (left-branch-b tree) (cadr tree))

(define (right-branch-b tree) (caddr tree))

(define (make-tree-b entry left right)
  (list entry left right))

;; the trees (from left to right) in fig.2.16
(define t1 '(7
            (3
             (1 () ())
             (5 () ()))
            (9
             ()
             (11 () ()))))

(define t2 '(3 (1 () ()) (7 (5 () ()) (9 () (11 () ())))))
(define t3 '(5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ()))))

(define (element-of-set-b? x set)
  (cond ((null? set) #f)
        ((= x (entry-b set)) #t)
        ((< x (entry-b set))
         (element-of-set-b? x (left-branch-b set)))
        ((> x (entry-b set))
         (element-of-set-b? x (right-branch-b set)))))

(check-expect (element-of-set-b? 3 t1) #t)
(check-expect (element-of-set-b? 4 t1) #f)
(check-expect (element-of-set-b? 5 t1) #t)
(check-expect (element-of-set-b? 11 t1) #t)
(check-expect (element-of-set-b? 20 t1) #f)

(define (adjoin-set-b x set)
  (cond ((null? set) (make-tree-b x '() '()))
        ((= x (entry-b set)) set)
        ((< x (entry-b set))
         (make-tree-b (entry-b set)
                    (adjoin-set-b x (left-branch-b set))
                    (right-branch-b set)))
        ((> x (entry-b set))
         (make-tree-b (entry-b set)
                    (left-branch-b set)
                    (adjoin-set-b x (right-branch-b set))))))

(check-expect (adjoin-set-b 4 t1) '(7 (3 (1 () ()) (5 (4 () ()) ())) (9 () (11 () ()))))
(check-expect (adjoin-set-b 8 t1) '(7 (3 (1 () ()) (5 () ())) (9 (8 () ()) (11 () ()))))

;; Ex.2.63
(define (tree->list-1 tree)
  (if (null? tree)
      '()
      (append (tree->list-1 (left-branch-b tree))
              (cons (entry-b tree)
                    (tree->list-1 (right-branch-b tree))))))

(check-expect (tree->list-1 t1) '(1 3 5 7 9 11))
(check-expect (tree->list-1 t2) '(1 3 5 7 9 11))
(check-expect (tree->list-1 t3) '(1 3 5 7 9 11))

(define (tree->list-2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
        result-list
        (copy-to-list (left-branch-b tree)
                      (cons (entry-b tree)
                            (copy-to-list (right-branch-b tree)
                                          result-list)))))
  (copy-to-list tree '()))

(check-expect (tree->list-2 t1) '(1 3 5 7 9 11))
(check-expect (tree->list-2 t2) '(1 3 5 7 9 11))
(check-expect (tree->list-2 t3) '(1 3 5 7 9 11))

;; a, same result.
;; 1 recursion (from left to right), 2 iteration (from right to left),
;; b, I guess they are the same, but generally, iteration require less memory?

;; Ex.2.64
(define (list->tree elements)
  (car (partial-tree elements (length elements))))

;(define (partial-tree elts n)
;  (if (= n 0)
;      (cons '() elts) ;; elts is ELement and TreeS
;      (let ((left-size (quotient (- n 1) 2)))
;        (let ((left-result (partial-tree elts left-size)))
;          (let ((left-tree (car left-result))
;                (non-left-elts (cdr left-result))
;                (right-size (- n (+ left-size 1))))
;            (let ((this-entry (car non-left-elts))
;                  (right-result (partial-tree (cdr non-left-elts)
;                                              right-size)))
;              (let ((right-tree (car right-result))
;                    (remaining-elts (cdr right-result)))
;                (cons (make-tree-b this-entry left-tree right-tree)
;                      remaining-elts))))))))

;; change from let to let*, for the sake of easy reading
(define (partial-tree elts n)
  (if (= n 0)
      (cons '() elts) ;; elts is ELement and TreeS
      (let* ([left-size (quotient (- n 1) 2)]             ;;ls
             [left-result (partial-tree elts left-size)]  ;;lr
             [left-tree (car left-result)]                ;;lt
             [non-left-elts (cdr left-result)]            ;;nle

             [this-entry (car non-left-elts)]             ;;te

             [right-size (- n (+ left-size 1))]           ;;rs
             [right-result (partial-tree (cdr non-left-elts) right-size)] ;;rr
             [right-tree (car right-result)]              ;;rt
             [remaining-elts (cdr right-result)])         ;;re
        (cons (make-tree-b this-entry left-tree right-tree)
              remaining-elts))))

;(list->tree '(1 3 5 7 9 11))
(check-expect (list->tree '(1 3 5 7 9 11)) '(5 (1 () (3 () ())) (9 (7 () ()) (11 () ()))))

;; a, delay this, sorry SICP, I don't fully understand the code, and I have to go on to next chapter, I will right back when I have time.
;; b, visit each number just one time, so O(n)?

;; Ex.2.65
(define (union-set-b tree1 tree2)
  (list->tree (union-set-o (tree->list-1 tree1) (tree->list-1 tree2))))

(define (intersection-set-b tree1 tree2)
  (list->tree (intersection-set-o (tree->list-1 tree1) (tree->list-1 tree2))))

(define tree1 (list->tree '(1 3 5 7 8 9 11)))
(define tree2 (list->tree '(2 4 5 6 8 10 11 12)))

(check-expect (union-set-b tree1 tree2) '(6 (3 (1 () (2 () ())) (4 () (5 () ()))) (9 (7 () (8 () ())) (11 (10 () ()) (12 () ())))))
(check-expect (intersection-set-b tree1 tree2) '(8 (5 () ()) (11 () ())))

;; Ex.2.66
;; unordered list set-of-records
(define (lookup given-key set-of-records)
  (cond ((null? set-of-records) #f)
        ((equal? given-key (key (car set-of-records)))
         (car set-of-records))
        (else (lookup given-key (cdr set-of-records)))))

(define key car)
(define number-list '((1 one) (2 two) (3 three)))
(check-expect (lookup 2 number-list) '(2 two))
(check-expect (lookup 0 number-list) #f)

;; binary tree record
(define (lookup-b given-key set)
  (if (null? set)
      #f
      (let* ([this-entry (entry-b set)]
             [this-entry-key (key this-entry)])
        (cond
          ((= given-key this-entry-key) this-entry)
          ((< given-key this-entry-key)
           (lookup-b given-key (left-branch-b set)))
          ((> given-key this-entry-key)
           (lookup-b given-key (right-branch-b set)))))))

(define st '((7 seven)
            ((3 three)
             ((1 one) () ())
             ((5 five) () ()))
            ((9 nine)
             ()
             ((11 eleven) () ()))))

(check-expect (lookup-b 9 st) '(9 nine))
(check-expect (lookup-b 6 st) #f)

;; Huffman Encoding Trees
(define (make-leaf symbol weight)
  (list 'leaf symbol weight))

(define (leaf? object)
  (eq? (car object) 'leaf))

(define (symbol-leaf x) (cadr x))

(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)
  (list left
        right
        (append (symbols left) (symbols right))
        (+ (weight left) (weight right))))

(define (left-branch-h tree) (car tree))

(define (right-branch-h tree) (cadr tree))

(define (symbols tree)
  (if (leaf? tree)
      (list (symbol-leaf tree))
      (caddr tree)))

(define (weight tree)
  (if (leaf? tree)
      (weight-leaf tree)
      (cadddr tree)))

(define (decode bits tree)
  (define (decode-1 bits current-branch)
    (if (null? bits)
        '()
        (let ((next-branch
               (choose-branch (car bits) current-branch)))
          (if (leaf? next-branch)
              (cons (symbol-leaf next-branch)
                    (decode-1 (cdr bits) tree))
              (decode-1 (cdr bits) next-branch)))))
  (decode-1 bits tree))

(define (choose-branch bit branch)
  (cond ((= bit 0) (left-branch-h branch))
        ((= bit 1) (right-branch-h branch))
        (else (error "bad bit -- CHOOSE-BRANCH" bit))))

;; generate ordered list
(define (adjoin-set-h x set)
  (cond ((null? set) (list x))
        ((< (weight x) (weight (car set))) (cons x set))
        (else (cons (car set)
                    (adjoin-set-h x (cdr set))))))

(define (make-leaf-set pairs)
  (if (null? pairs)
      '()
      (let ((pair (car pairs)))
        (adjoin-set-h (make-leaf (car pair)    ; symbol
                               (cadr pair))  ; frequency
                    (make-leaf-set (cdr pairs))))))

(define sample-pairs '((C 1) (A 4) (D 1) (B 2)))

(check-expect (make-leaf-set sample-pairs) '((leaf D 1) (leaf C 1) (leaf B 2) (leaf A 4)))

;; Ex.2.67
(define sample-tree
  (make-code-tree (make-leaf 'A 4)
                  (make-code-tree
                   (make-leaf 'B 2)
                   (make-code-tree (make-leaf 'D 1)
                                   (make-leaf 'C 1)))))

(check-expect sample-tree '((leaf A 4) ((leaf B 2) ((leaf D 1) (leaf C 1) (D C) 2) (B D C) 4) (A B D C) 8))


(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
(define sample-symbols '(A D A B B C A))
(check-expect (decode sample-message sample-tree) sample-symbols)
(check-expect (symbols sample-tree) '(A B D C))

;; Ex.2.68
(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
              (encode (cdr message) tree))))

(define (encode-symbol sym tree)
  (if (eq? (member sym (symbols tree)) #f)
      (error "Symbel not in tree -- " sym)
      (let ((r-b (right-branch-h tree))
            (l-b (left-branch-h tree)))
        (if (member sym (symbols l-b))
            (if (leaf? l-b) (list 0) (cons 0 (encode-symbol sym l-b)))
            (if (leaf? r-b) (list 1) (cons 1 (encode-symbol sym r-b)))))))

(check-expect (encode-symbol 'A sample-tree) '(0))
(check-expect (encode-symbol 'B sample-tree) '(1 0))
(check-expect (encode-symbol 'C sample-tree) '(1 1 1))
(check-expect (encode-symbol 'D sample-tree) '(1 1 0))
;(check-expect (encode-symbol 'E sample-tree) #f)

(check-expect (encode sample-symbols sample-tree) sample-message)

;; Ex.2.69
(define (generate-huffman-tree pairs)
  (car (successive-merge (make-leaf-set pairs))))

;; iteration
(define (successive-merge leaf-set-o)
  (if (= (length leaf-set-o) 1)
      leaf-set-o
      (successive-merge (adjoin-set-h
                         (make-code-tree (car leaf-set-o) (cadr leaf-set-o))
                         (cddr leaf-set-o)))))

(check-expect (generate-huffman-tree sample-pairs) '((leaf A 4) ((leaf B 2) ((leaf D 1) (leaf C 1) (D C) 2) (B D C) 4) (A B D C) 8))

;; Ex.2.70
(define word-pairs '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))

(check-expect (generate-huffman-tree word-pairs)
              '((leaf NA 16)
                ((leaf YIP 9)
                 (((leaf A 2) ((leaf WAH 1) (leaf BOOM 1) (WAH BOOM) 2) (A WAH BOOM) 4)
                  ((leaf SHA 3) ((leaf JOB 2) (leaf GET 2) (JOB GET) 4) (SHA JOB GET) 7)
                  (A WAH BOOM SHA JOB GET)
                  11)
                 (YIP A WAH BOOM SHA JOB GET)
                 20)
                (NA YIP A WAH BOOM SHA JOB GET)
                36))

(define lyrics
  '(GET A JOB
        SHA NA NA NA NA NA NA NA NA
        GET A JOB
        SHA NA NA NA NA NA NA NA NA
        WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP
        SHA BOOM))

(check-expect (length (encode lyrics (generate-huffman-tree word-pairs))) 84)
;; fixed length will be (3bit x 36) = 108bits
;; compression ratio: 84/108 = 78%

;; Ex.2.71
;; Very special case, bits required from most frequent to least frequent are 1,2,...,n

;; Ex.2.72
;; Not an interesting question, the encoding steps are proportional to the bits, and it depends on the structure of tree, and how to search the tree. For example, if the tree always extend to the right, and search tree in left-branch first order, we will need 2n step for the least frequent element; but if we search tree in right-branch first order, then we will get this element in n steps (minimum).

;;-------------------------------------------------------------------------
;; 2.4 Multiple Representations for Abstract Data
;;-------------------------------------------------------------------------
;; complex number systems
(define (add-complex z1 z2)
  (make-from-real-imag (+ (real-part z1) (real-part z2))
                       (+ (imag-part z1) (imag-part z2))))

(define (sub-complex z1 z2)
  (make-from-real-imag (- (real-part z1) (real-part z2))
                       (- (imag-part z1) (imag-part z2))))

(define (mul-complex z1 z2)
  (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                     (+ (angle z1) (angle z2))))

(define (div-complex z1 z2)
  (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                     (- (angle z1) (angle z2))))

;(define (attach-tag type-tag contents)
;  (if (number? contents)
;      contents
;      (cons type-tag contents)))
;
;(define (type-tag datum)
;  (cond
;    [(number? datum) 'scheme-number]
;    [(pair? datum) (car datum)]
;    [else
;     (error "Bad tagged datum -- TYPE-TAG" datum)]))
;
;(define (contents datum)
;  (cond
;    [(number? datum) datum]
;    [(pair? datum) (cdr datum)]
;    [else
;     (error "Bad tagged datum -- CONTENTS" datum)]))

(define (attach-tag type-tag contents)
  (cons type-tag contents))

(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "Bad tagged datum -- TYPE-TAG" datum)))

(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "Bad tagged datum -- CONTENTS" datum)))

(define (rectangular? z)
  (eq? (type-tag z) 'rectangular))

(define (polar? z)
  (eq? (type-tag z) 'polar))

;; Shall I implement a set/get system for verifing the code?
;; the generic programming may be a bit hard for me
;; Today, I read the article of Eli Bendersky's website, his work encourage me to move on,
;; Now I feel full of power again, like the moment when I faced the first problem of SICP.
;; Thank you, Eli Bendersky

;; Codes copied from http://eli.thegreenplace.net/2007/09/09/sicp-section-24/
;; Thank you, José Hérnandez

;; all data->proc are stored in one global table
(define *op-table* (make-hash))
(define (put op type proc)
  (hash-set! *op-table* (list op type) proc))
(define (get op type)
  (hash-ref *op-table* (list op type) #f))

;; test hash table
;(put-cot 'op1 'type1 'proc1)
;(check-expect (get-cot 'op1 'type1) 'proc1)
;(check-expect (get-cot 'op1 'type2) #f)
;(check-expect (hash-count *complex-op-table*) 1)

(define (install-rectangular-package)
  ;; internal procedures
  (define (real-part z) (car z))
  (define (imag-part z) (cdr z))
  (define (make-from-real-imag x y) (cons x y))
  (define (magnitude z)
    (sqrt (+ (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a)
    (cons (* r (cos a)) (* r (sin a))))

  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
           (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
           (lambda (r a) (tag (make-from-mag-ang r a))))
  'install-rectangular-package-done)

(define (install-polar-package)
  ;; internal procedures
  (define (magnitude z) (car z))
  (define (angle z) (cdr z))
  (define (make-from-mag-ang r a) (cons r a))
  (define (real-part z)
    (* (magnitude z) (cos (angle z))))
  (define (imag-part z)
    (* (magnitude z) (sin (angle z))))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y)))
          (atan y x)))

  ;; interface to the rest of the system
  (define (tag x) (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
           (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar
           (lambda (r a) (tag (make-from-mag-ang r a))))
  'install-polar-package-done)

;(define (apply-generic op . args)
;  (let ((type-tags (map type-tag args)))
;    (let ((proc (get op type-tags)))
;      (if proc
;          (apply proc (map contents args))
;          (error
;           "No method for these types -- APPLY-GENERIC"
;           (list op type-tags))))))

(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
(define (make-from-real-imag x y)
  ((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
  ((get 'make-from-mag-ang 'polar) r a))

;; some test cases for complex system
(install-rectangular-package)
(install-polar-package)

(define c-r (cons 'rectangular (cons 1 (sqrt 3))))
(check-expect (rectangular? c-r) #t)
(check-expect (polar? c-r) #f)
(check-within (contents c-r) (cons 1 1.732) 0.001)
(check-within (real-part c-r) 1 0.001)
(check-within (imag-part c-r) 1.732 0.001)
(check-within (magnitude c-r) 2.0 0.001)
(check-within (angle c-r) (/ pi 3) 0.001)

(define c-p (cons 'polar (cons (sqrt 2) (/ pi 4))))
(check-expect (rectangular? c-p) #f)
(check-expect (polar? c-p) #t)
(check-within (contents c-p) (cons (sqrt 2) (/ pi 4)) 0.001)
(check-within (real-part c-p) 1 0.001)
(check-within (imag-part c-p) 1 0.001)
(check-within (magnitude c-p) (sqrt 2) 0.001)
(check-within (angle c-p) (/ pi 4) 0.001)

(check-expect (rectangular? (add-complex c-r c-p)) #t)
(check-within (contents (add-complex c-r c-p)) (cons 2.0 2.732) 0.001)
(check-expect (rectangular? (sub-complex c-r c-p)) #t)
(check-within (contents (sub-complex c-r c-p)) (cons 0.0 0.732) 0.001)
(check-expect (polar? (mul-complex c-r c-p)) #t)
(check-within (contents (mul-complex c-r c-p)) (cons 2.828 1.832) 0.001)
(check-expect (polar? (div-complex c-r c-p)) #t)
(check-within (contents (div-complex c-r c-p)) (cons 1.414 0.261) 0.001)

;; Ex.2.73
;; data-directed deriv
(define (deriv-dd exp var)
  (cond ((number? exp) 0)
        ((variable? exp) (if (same-variable? exp var) 1 0))
        (else ((get 'deriv (operator exp)) (operands exp)
                                           var))))

;; the function works on prefix mode
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))

(define (install-deriv-package)
  ;; internal procedures
  (define (sum operands var)
    (make-sum
     (deriv-dd (car operands) var)
     (deriv-dd (cadr operands) var)))
  (define (product operands var)
    (make-sum
     (make-product (car operands)
                   (deriv-dd (cadr operands) var))
     (make-product (deriv-dd (car operands) var)
                   (cadr operands))))
  (define (exponent operands var)
    (make-product
     (make-product (cadr operands)
                   (make-exponentiation (car operands) (make-sum (cadr operands) -1)))
     (deriv-dd (car operands) var)))

  ;; interface to the rest of the system
  (put 'deriv '+ sum)
  (put 'deriv '* product)
  (put 'deriv '** exponent)
  'install-deriv-package-done)

;; Ex.2.73.a
;; Because number? and variable? don't have operator.

(install-deriv-package)
;; Ex.2.73.b
(check-expect (deriv-dd '(+ x 1) 'x) 1)
(check-expect (deriv-dd '(* x 2) 'x) 2)
(check-expect (deriv-dd '(+ (* x 2) 1) 'x) 2)
(check-expect (deriv-dd '(+ (* x 2) (* 5 x)) 'x) 7)

;; Ex.2.73.c (my make functions are in infix mode and I don't want to change it, the output is right but mixed of prefix and infix mode)
(check-expect (deriv-dd '(** x 1) 'x) 1)
(check-expect (deriv-dd '(** x 2) 'x) '(2 * x))
(check-expect (deriv-dd '(** x 3) 'x) '(3 * (x ** 2)))
(check-expect (deriv-dd '(** (+ x 2) 3) 'x) '(3 * ((+ x 2) ** 2)))

;; Ex.2.73.d I guess nothing should be changed.

;; Ex.2.74
(define div-1-file '(div-1 ((Name Age Salary) (Mike 39 10000) (Richard 28 5000))))
(define div-2-file '(div-2 ((Name Salary Age) (Alice 1000 22) (Chris 7000 35))))
(define div-flist (cons div-1-file (list div-2-file)))

(define (install-div-1-package)
  (define (get-record name file)
    (define (get-record-from-records name records)
      (if (null? records)
          #f
          (let ((record (car records)))
            (cond
              [(eq? name (car record)) record]
              [else (get-record-from-records name (cdr records))]))))
    (get-record-from-records name (cadr file)))
  (define (get-age name file)
    (let ((record (get-record name file)))
      (if (eq? record #f)
          #f
          (cadr record))))
  (define (get-salary name file)
    (let ((record (get-record name file)))
      (if (eq? record #f)
          #f
          (caddr record))))
  (put 'div-1 'record get-record)
  (put 'div-1 'salary get-salary)
  (put 'div-1 'age get-age)
  'install-div-1-package-done)

(define (install-div-2-package)
  (define (get-record name file)
    (define (get-record-from-records name records)
      (if (null? records)
          #f
          (let ((record (car records)))
            (cond
              [(eq? name (car record)) record]
              [else (get-record-from-records name (cdr records))]))))
    (get-record-from-records name (cadr file)))
  (define (get-age name file)
    (let ((record (get-record name file)))
      (if (eq? record #f)
          #f
          (caddr record))))
  (define (get-salary name file)
    (let ((record (get-record name file)))
      (if (eq? record #f)
          #f
          (cadr record))))
  (put 'div-2 'record get-record)
  (put 'div-2 'salary get-salary)
  (put 'div-2 'age get-age)
  'install-div-2-package-done)

;; Ex.2.74.a
(install-div-1-package)
(install-div-2-package)
(define (get-record name file)
  ((get (car file) 'record) name file))

(check-expect (get-record 'Mike div-1-file) '(Mike 39 10000))
(check-expect (get-record 'Richard div-1-file) '(Richard 28 5000))
(check-expect (get-record 'Chris div-2-file) '(Chris 7000 35))
(check-expect (get-record 'John div-2-file) #f)

;; Ex.2.74.b
(define (get-salary name file)
  ((get (car file) 'salary) name file))

(check-expect (get-salary 'Mike div-1-file) 10000)
(check-expect (get-salary 'Chris div-2-file) 7000)
(check-expect (get-salary 'John div-2-file) #f)

;; Ex.2.74.c
(define (find-employee-record name flist)
  (if (null? flist)
      #f
      (let ((record (get-record name (car flist))))
        (cond
          [(eq? record #f) (find-employee-record name (cdr flist))]
          [else record]))))

(check-expect (find-employee-record 'Mike div-flist) '(Mike 39 10000))
(check-expect (find-employee-record 'Chris div-flist) '(Chris 7000 35))
(check-expect (find-employee-record 'John div-flist) #f)

;; Ex.2.74.d, Add a install-div-n-package will be OK.

;; Message passing (I don't understand it)
;; What does it mean by "decomposing the operation-and-type table into rows"?
;; Ex.2.75
(define (make-from-real-imag-mp x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) x)
          ((eq? op 'imag-part) y)
          ((eq? op 'magnitude)
           (sqrt (+ (square x) (square y))))
          ((eq? op 'angle) (atan y x))
          (else
           (error "Unknown op -- MAKE-FROM-REAL-IMAG" op))))
  dispatch)

;; op is the "message" that is passed to arg
;; as we know other style of programming is always arg->op
(define (apply-generic-mp op arg) (arg op))

(define c-r-2 (make-from-real-imag-mp 1 (sqrt 3)))
(check-within (apply-generic-mp 'real-part c-r-2) 1 0.001)
(check-within (apply-generic-mp 'imag-part c-r-2) 1.732 0.001)
(check-within (apply-generic-mp 'magnitude c-r-2) 2 0.001)
(check-within (apply-generic-mp 'angle c-r-2) 1.047 0.001)

(define (make-from-mag-ang-mp x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* x (cos y)))
          ((eq? op 'imag-part) (* x (sin y)))
          ((eq? op 'magnitude) x)
          ((eq? op 'angle) y)
          (else
           (error "Unknown op -- MAKE-FROM-REAL-IMAG" op))))
  dispatch)

(define c-p-2 (make-from-mag-ang-mp 2 (/ pi 3)))
(check-within (apply-generic-mp 'real-part c-p-2) 1 0.001)
(check-within (apply-generic-mp 'imag-part c-p-2) 1.732 0.001)
(check-within (apply-generic-mp 'magnitude c-p-2) 2 0.001)
(check-within (apply-generic-mp 'angle c-p-2) 1.047 0.001)

;; Ex.2.76
;; a) generic operations with explicit dispatch (seems to be most awkward in the three choices)
;; b) data-directed style
;; c) message-passing-style
;; Which organization would be most appropriate for a system in which new types must often be added? (b)
;; Which would be most appropriate for a system in which new operations must often be added? (c)
;; How to choose: (1) addtive module (2) write as little code as possible
;; But I think the meaning of (b) and (c) are interchangable, both of them work on function in terms of type (only (a) works on function in terms of operations). So, both (b) and (c) are good for new type and new operaions
;; Am I wrong? Doubt...data-directed style seems to be more general and close to object-oriented ideas

;;-------------------------------------------------------------------------
;; 2.5 Systems with Generic Operations
;;-------------------------------------------------------------------------
;; Generic Arithmetic Operations
(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))
(define (exp x y) (apply-generic 'exp x y))
(define (equ? x y)
  (if (eq? (type-tag x) (type-tag y))
      (apply-generic 'equ? x y)
      #f))
(define (=zero? x) (apply-generic '=zero? x))
(define (raise x) (apply-generic 'raise x))
(define (project x) (apply-generic 'project x))
(define (drop x)
  (let ([x-project (project x)])
    (if (equ? (raise x-project) x) (drop x-project) x)))

(define (install-scheme-number-package)
  (define (tag x)
    (attach-tag 'scheme-number x))
  (put 'add '(scheme-number scheme-number)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(scheme-number scheme-number)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(scheme-number scheme-number)
       (lambda (x y) (tag (* x y))))
  (put 'div '(scheme-number scheme-number)
       (lambda (x y) (tag (/ x y))))
  (put 'exp '(scheme-number scheme-number)
                    (lambda (x y) (tag (expt x y)))) ; using primitive `expt'
  (put 'equ? '(scheme-number scheme-number)
       (lambda (x y) (= x y)))
  (put '=zero? '(scheme-number)
       (lambda (x) (eq? x 0)))
  (put 'make 'scheme-number
       (lambda (x) (tag x)))
  'install-scheme-number-package-done)

(define (make-scheme-number n)
  ((get 'make 'scheme-number) n))

(define (install-integer-package)
  (define (tag x)
    (attach-tag 'integer x))
  (put 'add '(integer integer)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(integer integer)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(integer integer)
       (lambda (x y) (tag (* x y))))
  (put 'div '(integer integer)
       (lambda (x y) (tag (/ x y))))
  (put 'exp '(integer integer)
                    (lambda (x y) (tag (expt x y)))) ; using primitive `expt'
  (put 'equ? '(integer integer)
       (lambda (x y) (= x y)))
  (put '=zero? '(integer)
       (lambda (x) (eq? x 0)))
  (put 'raise '(integer)
       (lambda (x) (attach-tag 'rational (cons x 1))))
  (put 'project '(integer)
       (lambda (x) (attach-tag 'integer x)))
  (put 'make 'integer
       (lambda (x) (tag x)))
  (put 'layer 'integer 1)
  'install-integer-package-done)

(define (make-integer n)
  ((get 'make 'integer) n))


(define (install-rational-package)
  ;; internal procedures
  (define (numer x) (car x))
  (define (denom x) (cdr x))
  (define (make-rat n d)
    (let ((g (gcd n d)))
      (cons (/ n g) (/ d g))))
  (define (add-rat x y)
    (make-rat (+ (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (- (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (* (numer x) (numer y))
              (* (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (equ?-rat x y)
    (= (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (=zero?-rat x)
    (= (numer x) 0))
  ;; interface to rest of the system
  (define (tag x) (attach-tag 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'equ? '(rational rational)
       (lambda (x y) (equ?-rat x y)))
  (put '=zero? '(rational)
       (lambda (x) (=zero?-rat x)))
  (put 'raise '(rational)
       (lambda (x) (attach-tag 'real (+ (/ (numer x) (denom x) ) 0.0))))
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  (put 'layer 'rational 2)
  (put 'project '(rational)
       (lambda (x) (attach-tag 'integer (numer x))))
  'install-rational-package-done)

(define (make-rational n d)
  ((get 'make 'rational) n d))

(define (install-real-package)
  (define (tag x)
    (attach-tag 'real x))
  (put 'add '(real real)
       (lambda (x y) (tag (+ x y))))
  (put 'sub '(real real)
       (lambda (x y) (tag (- x y))))
  (put 'mul '(real real)
       (lambda (x y) (tag (* x y))))
  (put 'div '(real real)
       (lambda (x y) (tag (/ x y))))
  (put 'exp '(real real)
                    (lambda (x y) (tag (expt x y)))) ; using primitive `expt'
  (put 'equ? '(real real)
       (lambda (x y) (= x y)))
  (put '=zero? '(real)
       (lambda (x) (eq? x 0.0)))
  (put 'raise '(real)
       (lambda (x) (attach-tag 'complex (make-from-real-imag x 0))))
  (put 'make 'real
       (lambda (x) (tag x)))
  (put 'layer 'real 3)
  (put 'project '(real)
       ;(lambda (x) (attach-tag 'integer (inexact->exact (round x)))))
       (lambda (x) (make-rational (inexact->exact (round x)) 1)))
  'install-real-package-done)

(define (make-real n)
  ((get 'make 'real) n))

(define (install-complex-package)
  ;; imported procedures from rectangular and polar packages
  (define (make-from-real-imag x y)
    ((get 'make-from-real-imag 'rectangular) x y))
  (define (make-from-mag-ang r a)
    ((get 'make-from-mag-ang 'polar) r a))

  ;; internal procedures
  (define (add-complex z1 z2)
    (make-from-real-imag (+ (real-part z1) (real-part z2))
                         (+ (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (- (real-part z1) (real-part z2))
                         (- (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (* (magnitude z1) (magnitude z2))
                       (+ (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                       (- (angle z1) (angle z2))))
  (define (equ?-complex z1 z2)
    (and (= (real-part z1) (real-part z2))
                         (= (imag-part z1) (imag-part z2))))
  (define (=zero?-complex z1)
    (and (= (real-part z1) 0) (= (imag-part z1) 0)))
  ;; interface to rest of the system
  (define (tag z) (attach-tag 'complex z))
  (put 'add '(complex complex)
       (lambda (z1 z2) (tag (add-complex z1 z2))))
  (put 'sub '(complex complex)
       (lambda (z1 z2) (tag (sub-complex z1 z2))))
  (put 'mul '(complex complex)
       (lambda (z1 z2) (tag (mul-complex z1 z2))))
  (put 'div '(complex complex)
       (lambda (z1 z2) (tag (div-complex z1 z2))))
  (put 'equ? '(complex complex)
       (lambda (z1 z2) (equ?-complex z1 z2)))
  (put '=zero? '(complex)
       (lambda (z1) (=zero?-complex z1)))
  (put 'make-from-real-imag 'complex
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'complex
       (lambda (r a) (tag (make-from-mag-ang r a))))
  (put 'real-part '(complex) real-part)
  (put 'imag-part '(complex) imag-part)
  (put 'magnitude '(complex) magnitude)
  (put 'angle '(complex) angle)
  (put 'layer 'complex 4)
  (put 'project '(complex)
       (lambda (z) (attach-tag 'real (real-part z))))
  'install-complex-package-done)

(install-scheme-number-package)
(install-integer-package)
(install-rational-package)
(install-real-package)
(install-complex-package)

;; some test case for 2.5.1
(define s1 (cons 'scheme-number 7))
(define s2 (cons 'scheme-number 3))
(check-expect (add s1 s2) (cons 'scheme-number 10))
(check-expect (sub s1 s2) (cons 'scheme-number 4))
(check-expect (mul s1 s2) (cons 'scheme-number 21))
(check-expect (div s1 s2) (cons 'scheme-number (/ 7 3)))

(define r1 (cons 'rational (cons 1 2)))
(define r2 (cons 'rational (cons 1 3)))
(check-expect (add r1 r2) (cons 'rational (cons 5 6)))
(check-expect (sub r1 r2) (cons 'rational (cons 1 6)))
(check-expect (mul r1 r2) (cons 'rational (cons 1 6)))
(check-expect (div r1 r2) (cons 'rational (cons 3 2)))

(define cr (cons 'complex (cons 'rectangular (cons 1 (sqrt 3)))))
(check-expect (rectangular? (contents cr)) #t)
(check-within (contents (contents cr)) (cons 1 1.732) 0.001)
(check-within (real-part cr) 1 0.001)
(check-within (imag-part cr) 1.732 0.001)
(check-within (magnitude cr) 2.0 0.001)
(check-within (angle cr) (/ pi 3) 0.001)

(define cp (cons 'complex (cons 'polar (cons (sqrt 2) (/ pi 4)))))
(check-expect (polar? (contents cp)) #t)
(check-within (contents (contents cp)) (cons (sqrt 2) (/ pi 4)) 0.001)
(check-within (real-part cp) 1 0.001)
(check-within (imag-part cp) 1 0.001)
(check-within (magnitude cp) (sqrt 2) 0.001)
(check-within (angle cp) (/ pi 4) 0.001)

(check-expect (rectangular? (contents (add cr cp))) #t)
(check-within (contents (contents (add cr cp))) (cons 2.0 2.732) 0.001)
(check-expect (rectangular? (contents (sub cr cp))) #t)
(check-within (contents (contents (sub cr cp))) (cons 0.0 0.732) 0.001)
(check-expect (polar? (contents (mul cr cp))) #t)
(check-within (contents (contents (mul cr cp))) (cons 2.828 1.832) 0.001)
(check-expect (polar? (contents (div cr cp))) #t)
(check-within (contents (contents (div cr cp))) (cons 1.414 0.261) 0.001)

;; Ex.2.77
;; Step 1: (apply-generic 'magnitude z1)
;; Step 2: look up in table
;; Step 3: (magnitude (cons 'rectangular (cons 3 4)))
;; Step 4: (apply-generic 'magnitude z) ;; the z changed (without 'complex)
;; Step 5: look up in table
;; Step 6: use function magnitude in install-rectangular-package
;; call apply-generic 2 times
(define z1 (cons 'complex (cons 'rectangular (cons 3 4))))
(check-expect (apply-generic 'magnitude z1) 5)

;; Ex.2.78 (code above, conflict in exercises, so comment out the test code)
;(define s1 7)
;(define s2 3)
;(check-expect (add s1 s2) 10)
;(check-expect (sub s1 s2) 4)
;(check-expect (mul s1 s2) 21)
;(check-expect (div s1 s2) (/ 7 3))

;; Ex.2.79 (code above)
;(define s3 7)
;(define s4 0)
;(check-expect (equ? s1 s2) #f)
;(check-expect (equ? s1 s3) #t)

(define r3 (cons 'rational (cons 1 2)))
(define r4 (cons 'rational (cons 0 3)))
(check-expect (equ? r1 r2) #f)
(check-expect (equ? r1 r3) #t)

(define cr1 (cons 'complex (cons 'rectangular (cons 1 2))))
(define cr2 (cons 'complex (cons 'rectangular (cons 1 3))))
(define cr3 (cons 'complex (cons 'rectangular (cons 1 2))))
(define cr4 (cons 'complex (cons 'rectangular (cons 0 0))))
(check-expect (equ? cr1 cr2) #f)
(check-expect (equ? cr1 cr3) #t)
(check-expect (=zero? cr1) #f)
(check-expect (=zero? cr4) #t)

;; Ex.2.80 (code above)
;(check-expect (=zero? s1) #f)
;(check-expect (=zero? s4) #t)
(check-expect (=zero? r1) #f)
(check-expect (=zero? r4) #t)
(check-expect (=zero? cr1) #f)
(check-expect (=zero? cr4) #t)

;; tower of type, the idea like inheritance
(define (complex? x)
  (eq? (type-tag x) 'complex))

(define (real? x)
  (eq? (type-tag x) 'real))

(define (rational? x)
  (eq? (type-tag x) 'rational))

(define (apply-generic op . args) ;; suppose (length args) >= 1
  (define (apply-generic-rec op args);; recursion
    (if (> (length args) 2)
        (apply-generic-rec op
                       (cons (apply-generic op (car args) (cadr args)) (cddr args)))
        (let ((type-tags (map type-tag args))) ;; (length args) should be 1 or 2
          (let ((proc (get op type-tags)))
            (if proc
                (apply proc (map contents args))
                (if (= (length args) 2)
                    (let ((type1 (car type-tags))
                          (type2 (cadr type-tags))
                          (a1 (car args))
                          (a2 (cadr args)))
                      (cond
                        [(eq? type1 type2)
                         (error "Error[1]:No method for these types" (list op type-tags))]
                        [(> (get 'layer type1) (get 'layer type2))
                         (apply-generic op a1 (raise a2))]
                        [else
                         (apply-generic op (raise a1) a2)]))
                    (error "Error[2]:No method for these types"
                           (list op type-tags))))))))
  (apply-generic-rec op args))

;; all data coercion are stored in one global table
(define *coercion-table* (make-hash))
(define (put-coercion type1 type2 t1->t2)
  (hash-set! *coercion-table* (list type1 type2) t1->t2))
(define (get-coercion type1 type2)
  (hash-ref *coercion-table* (list type1 type2) #f))

(define (install-coercion-package)
  (define (scheme-number->complex n)
    (make-from-real-imag (contents n) 0))
  (put-coercion 'scheme-number 'complex scheme-number->complex)
  'install-coercion-package-done)

;; Ex.2.81.a
(install-coercion-package)
;(check-expect (exp 2 3) 8)
;(exp cr1 cr2), exp take 2 complex will run into a endless loop
;; Ex.2.81.b
;; apply-generic should avoid coerce 2 datum when they are the same type
;; Ex.2.81.c
;;(exp cr1 cr2)
;; above code will give out an error

;; Ex.2.82
;; Suppose the type tower is A-B-C(from highest to lowest), and the coercion rule in table is C->B and B->A.
;; If we apply two data with type A and C, apply-generic will not find out we can do something like (B->A (C->B C)).
;; So I skip the code writing and move directly to "raise scheme" in the next exercise.

;; Ex.2.83
;; there is a code conflict with Ex.2.78, so I have to revert some of the code to old version
(check-expect (raise (cons 'integer 5)) (cons 'rational (cons 5 1)))
(check-expect (raise (cons 'rational (cons 5 2))) (cons 'real 2.5))
(check-expect (raise (cons 'real 2.5)) (cons 'complex (cons 'rectangular (cons 2.5 0))))

;; Ex.2.84 (add 'layer to hash table, not a good idea?)
(define r5 (cons 'rational (cons 1 6)))
;; 4 types: integer, rational, real, complex
(define i1 (cons 'integer 2))
(define real1 (cons 'real 2.5))
;; integer + rational & reverse
(check-expect (add i1 r5) (cons 'rational (cons 13 6)))
(check-expect (add r5 i1) (cons 'rational (cons 13 6)))
;; integer + real & reverse
(check-expect (add i1 real1) (cons 'real 4.5))
(check-expect (add real1 i1) (cons 'real 4.5))
;; integer + complex & reverse
(check-expect (add i1 cr1) (cons 'complex (cons 'rectangular (cons 3.0 2))))
(check-expect (add cr1 i1) (cons 'complex (cons 'rectangular (cons 3.0 2))))
;; rational + complex & reverse
(check-expect (add r3 cr1) (cons 'complex (cons 'rectangular (cons 1.5 2))))
(check-expect (add cr1 r3) (cons 'complex (cons 'rectangular (cons 1.5 2))))
;; rational + real & reverse
(check-expect (add r3 real1) (cons 'real 3.0))
(check-expect (add real1 r3) (cons 'real 3.0))
;; real + complex & reverse
(check-expect (add real1 cr1) (cons 'complex (cons 'rectangular (cons 3.5 2))))
(check-expect (add cr1 real1) (cons 'complex (cons 'rectangular (cons 3.5 2))))

;; multiple arguments on apply-generic
(check-expect (apply-generic 'add real1 i1 cr1) (cons 'complex (cons 'rectangular (cons 5.5 2))))
(check-expect (apply-generic 'add i1 real1 cr1) (cons 'complex (cons 'rectangular (cons 5.5 2))))
(check-expect (apply-generic 'add real1 cr1 i1) (cons 'complex (cons 'rectangular (cons 5.5 2))))
(check-expect (apply-generic 'add cr1 real1 i1) (cons 'complex (cons 'rectangular (cons 5.5 2))))

;; Ex.2.85 (first project, then drop)
(check-expect (project cr1) (cons 'real 1))
(check-expect (project real1) (cons 'rational (cons 2 1)))
(define r6 (cons 'rational (cons 6 1)))
(check-expect (project r6) (cons 'integer 6))

(check-expect (drop (cons 'complex (cons 'rectangular (cons 2.5 2)))) (cons 'complex (cons 'rectangular (cons 2.5 2))))
(check-expect (drop (cons 'complex (cons 'rectangular (cons 2.5 0)))) (cons 'real 2.5))
(check-expect (drop (cons 'integer 2)) (cons 'integer 2))
(check-expect (drop (make-rational 6 1)) (cons 'integer 6))
(check-expect (drop (make-rational 6 2)) (cons 'integer 3))
(check-expect (drop (cons 'real 2.0)) (cons 'integer 2))
(check-expect (drop (cons 'complex (cons 'rectangular (cons 2.0 0.0)))) (cons 'integer 2))

(define cr6 (cons 'complex (cons 'rectangular (cons -3.5 -2))))
;; there is an endless loop when I add drop to apply-generic, and it is hard to trace what test case cause the loop, skip here.
(check-expect (drop (apply-generic 'add cr1 real1 cr6 i1)) (cons 'integer 2))

;; Ex.2.86
;; I want to skip this exercise, it's code heavy and I am tired of this topic

;; Symbolic Algebra (hard and need time)
;; I will go back when finish 3.1?
;(define (add-poly p1 p2)
;  (if (same-variable? (variable p1) (variable p2))
;      (make-poly (variable p1)
;                 (add-terms (term-list p1)
;                            (term-list p2)))
;      (error "Polys not in same var -- ADD-POLY"
;             (list p1 p2))))
;
;(define (mul-poly p1 p2)
;  (if (same-variable? (variable p1) (variable p2))
;      (make-poly (variable p1)
;                 (mul-terms (term-list p1)
;                            (term-list p2)))
;      (error "Polys not in same var -- MUL-POLY"
;             (list p1 p2))))
;
;(define (install-polynomial-package)
;  ;; internal procedures
;  ;; representation of poly
;  (define (make-poly variable term-list)
;    (cons variable term-list))
;  (define (variable p) (car p))
;  (define (term-list p) (cdr p))
;  <_procedures `same-variable?' and `variable?' from section 2.3.2_>
;
;  ;; representation of terms and term lists
;  <_procedures `adjoin-term' ... `coeff' from text below_>
;
;  ;; continued on next page
;
;  (define (add-poly p1 p2) ...)
;  <_procedures used by `add-poly'_>
;  (define (mul-poly p1 p2) ...)
;  <_procedures used by `mul-poly'_>
;
;  ;; interface to rest of the system
;  (define (tag p) (attach-tag 'polynomial p))
;  (put 'add '(polynomial polynomial)
;       (lambda (p1 p2) (tag (add-poly p1 p2))))
;  (put 'mul '(polynomial polynomial)
;       (lambda (p1 p2) (tag (mul-poly p1 p2))))
;  (put 'make 'polynomial
;       (lambda (var terms) (tag (make-poly var terms))))
;  'install-polynomial-package-done)
;
;(define (add-terms L1 L2)
;  (cond ((empty-termlist? L1) L2)
;        ((empty-termlist? L2) L1)
;        (else
;         (let ((t1 (first-term L1)) (t2 (first-term L2)))
;           (cond ((> (order t1) (order t2))
;                  (adjoin-term
;                   t1 (add-terms (rest-terms L1) L2)))
;                 ((< (order t1) (order t2))
;                  (adjoin-term
;                   t2 (add-terms L1 (rest-terms L2))))
;                 (else
;                  (adjoin-term
;                   (make-term (order t1)
;                              (add (coeff t1) (coeff t2)))
;                   (add-terms (rest-terms L1)
;                              (rest-terms L2)))))))))
;
;(define (mul-terms L1 L2)
;  (if (empty-termlist? L1)
;      (the-empty-termlist)
;      (add-terms (mul-term-by-all-terms (first-term L1) L2)
;                 (mul-terms (rest-terms L1) L2))))
;
;(define (mul-term-by-all-terms t1 L)
;  (if (empty-termlist? L)
;      (the-empty-termlist)
;      (let ((t2 (first-term L)))
;        (adjoin-term
;         (make-term (+ (order t1) (order t2))
;                    (mul (coeff t1) (coeff t2)))
;         (mul-term-by-all-terms t1 (rest-terms L))))))
;
;(define (adjoin-term term term-list)
;  (if (=zero? (coeff term))
;      term-list
;      (cons term term-list)))
;
;(define (the-empty-termlist) '())
;(define (first-term term-list) (car term-list))
;(define (rest-terms term-list) (cdr term-list))
;(define (empty-termlist? term-list) (null? term-list))
;
;(define (make-term order coeff) (list order coeff))
;(define (order term) (car term))
;(define (coeff term) (cadr term))

;; Ex.2.87
;; Ex.2.88
;; Ex.2.89
;; Ex.2.90
;; Ex.2.91
;; Ex.2.92
;; Ex.2.93
;; Ex.2.94
;; Ex.2.95
;; Ex.2.96
;; Ex.2.97

;;-------------------------------------------------------------------------
;; Others
;;-------------------------------------------------------------------------
;; A bug found in test-engine/scheme-tests.
;; But, as the maintainer said, the behavior is expected?
(define a 'b)
(check-expect (eq? a 'b) #f) ; a = 'c, wrong?
(check-expect (eq? a 'c) #t)
(set! a 'c)
(check-expect (eq? a 'c) #t)

;; run all tests
(test)

